home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
CRS
/
crs54.d81
/
trans12c.lbr
/
TRANS-05.INC
< prev
next >
Wrap
Text File
|
2009-10-10
|
7KB
|
298 lines
procedure Set_FileLengthCPM;
begin
CPM_FCB.DriveCode := CPM_Drive + 1;
move(DOS_FCB^.Name, CPM_FCB.Name, 8);
move(DOS_FCB^.Extention, CPM_FCB.Extention, 3);
I := ord(CPM_FCB.Name[6]);
I := I or $80; {set high bit f6'}
CPM_FCB.Name[6] := chr(I);
for I := 0 to 19 do
mem[addr(CPM_FCB.Extent) + I] := 0;
CPM_FCB.CR := 128 - (DOS_FCB^.FileSize[1] and $7F);
bdos(SETATT, addr(CPM_FCB));
end;
function NumberOfRecords(Index: integer): integer;
var
I: integer;
begin
I := (Index - 1) div 128;
if (((Index - 1) mod 128) > 0) then
I := I + 1;
NumberOfRecords := I;
end;
Function SizeDOS_File(Var A: SizeArray): Real;
Begin
SizeDOS_File:= (A[1] + (256.0 * A[2]) + (256.0 * 256.0 * A[3]) +
(256.0 * 256.0 * 256.0 * A[4]));
End;
procedure BufferToScreen;
var
I, J: integer;
begin
I := 1;
while (I < BufferIndex) and not Stop do
begin
J := ord(DataBuffer[I]);
if (J = $0A) or (J = $0D) or ((J > $1F) and (J < $80)) then
write(DataBuffer[I]);
Stop := Stop or Break;
I := I + 1;
end;
end;
procedure ReadMS_DOS;
var
FileName: Str20;
CPMName: Str20;
I,Err: integer;
Cl: integer;
RecordsPerCluster: integer;
Size: Real;
procedure AdvanceDataBufferIndex;
begin
if (NumberOfClusters > 0) then
begin
NumberOfClusters := NumberOfClusters - 1;
BufferIndex := BufferIndex + RecordsPerCluster * 128;
end
else
BufferIndex := BufferIndex + ExtraBytes;
end;
begin (* ReadMS_DOS *)
{bdos(RESETDSK);} {for safety}
IdentifyMS_DOS;
if not (Identity = Unidentified) then
begin
ClrScr;
writeln;
if (Selection = '2') then
writeln('File Transfer From MS-DOS to CP/M')
else
writeln('View a Text File on MS_DOS Disk');
writeln;
write('File Name to Get From MS-DOS: ');
readln(FileName);
writeln;
Stop:= false;
CheckWildcard(FileName);
SearchFirst(FileName,Err);
While VolumeName or SubDirName do
SearchNext(FileName,Err);
if (Err = EODirectory) then
begin
write('File Not Found, ');
end
else
begin
writeln('Transfering -');
RecordsPerCluster:= RecordsPerSector * SecsPerCluster;
BiosSelect(CPM_Drive, First);
repeat
CPMName:= '';
for I:= 1 to NameSize do
if not (DOS_FCB^.Name[I]=' ') then
CPMName:= CPMName + DOS_FCB^.Name[I];
CPMName:= CPMName + '.';
for I:= 1 to TypeSize do
CPMName:= CPMName + DOS_FCB^.Extention[I];
if (Selection = '2') then
CPMName:= concat(CPM_DriveCh,':',CPMName);
writeln(CPMName);
if (Selection = '2') then
begin
assign(CPMFile,CPMName);
rewrite(CPMFile);
end
else
begin
writeln;
writeln('Press <CTRL-S> to pause, <ESC> to abort -');
writeln;
end;
Stop := Stop or Break;
if not Stop then
begin
Cl:= DOS_FCB^.ClusterNo;
Size:= SizeDOS_File(DOS_FCB^.FileSize);
NumberOfClusters := Trunc(Size / (RecordsPerCluster * 128.0));
ExtraBytes := Trunc(Size - (NumberOfClusters
* RecordsPerCluster * 128.0));
fillchar(DataBuffer, DataBufferSize, 0);
BufferIndex := 1;
BiosSelect(MS_DOS_Drive, Next);
while (Cl < $FF8) and not Stop do
begin
ReadCluster(Cl, BufferIndex);
AdvanceDataBufferIndex;
if ((BufferIndex-1)>DataBufferSize-(RecordsPerCluster*128)) then
begin
BiosSelect(CPM_Drive, Next);
if (Selection = '2') then
blockwrite(CPMFile,DataBuffer[1],NumberOfRecords(BufferIndex))
else
BufferToScreen;
BiosSelect(MS_DOS_Drive, Next);
fillchar(DataBuffer, DataBufferSize, 0);
BufferIndex := 1;
end;
Cl:= FATPointer(Cl); (* Point to Next Cluster *)
end;
BiosSelect(CPM_Drive, Next);
DataBuffer[BufferIndex] := ^Z;
if (Selection = '2') then
begin
blockwrite(CPMFile, DataBuffer[1], NumberOfRecords(BufferIndex));
close(CPMFile);
if (CPMversion > $30) then Set_FileLengthCPM;
end
else
if not Stop then BufferToScreen;
end; (* if not Stop *)
Stop := Stop or Break;
if Wildcard and not Stop then
begin
BiosSelect(MS_DOS_Drive, Next);
Repeat
SearchNext(FileName,Err);
Until Not (VolumeName or SubDirName);
if not (Err = EODirectory) then
BiosSelect(CPM_Drive, Next);
end;
until (Err = EODirectory) or Stop or not Wildcard;
writeln;
writeln;
end; (* if EODirectory *)
if Stop then write('Aborted, ');
Continue;
end;
end;
procedure DirMS_DOS;
var
ErrorCode,
Count,
I,N: integer;
X: real;
FileName: Str20;
MonthString: array[0..38] of char;
begin
MonthString:= '...JanFebMarAprMayJunJulAugSepOctNovDec';
Count:= 0;
IdentifyMS_DOS;
if not (Identity = Unidentified) then
begin
ClrScr;
writeln;
write('Dir Mask: ');
readln(FileName);
writeln;
writeln('Name',
'Attrubutes':18,
'Clstr':7,
'Date':13,
'Time':10,
'Size':8);
for I:= 1 to 60 do write('-');
SearchFirst(FileName,ErrorCode);
repeat
if (ErrorCode = FoundDir) then
begin
writeln;
Count:= Count + 1;
with DOS_FCB^ do
begin
for I:= 1 to NameSize do write(Name[I]);
write('.');
for I:= 1 to TypeSize do write(Extention[I]);
write(' ');
N:= Attribute;
If VolumeName Then
Write('<VolNam>')
Else if SubDirName Then
Write('<SubDir>')
Else
for I:= 1 to 8 do
begin
write(chr(((N shr 7) and 1) + $30));
N:= N shl 1;
end;
write(ClusterNo:7);
write(' ');
N:= ((Date shr 5) and $F);
if (N > 12) then N:= 0;
N:= N * 3;
for I:= N to N+2 do write(MonthString[I]);
write(' ');
N:= Date and $1F;
if N < 10 then write('0');
write(N);
write(',',(Date shr 9) + 1980);
write(' ');
N:= (Time shr 11);
if N < 10 then write('0');
write(N,':');
N:= ((Time shr 5) and 63);
if N < 10 then write('0');
write(N,':');
N:= ((Time and $1F) * 2);
if N < 10 then write('0');
write(N);
write(' ',SizeDOS_File(FileSize):6:0);
end;
end;
SearchNext(FileName,ErrorCode);
until (ErrorCode = EODirectory) or Break;
writeln;
writeln;
writeln('File Count: ',Count);
Continue;
end;
end;
procedure MapMS_DOS;
begin
IdentifyMS_DOS;
if not (Identity = Unidentified) then
begin
ClrScr;
for I:= 0 to NClusters -1 do
begin
if (I mod 18) = 0 then writeln;
write(FATPointer(I + 2),',')
end;
writeln;
writeln;
continue;
end;
end;